home *** CD-ROM | disk | FTP | other *** search
/ Gekikoh Dennoh Club 1 / Gekikoh Dennoh Club Vol. 1 (Japan).7z / Gekikoh Dennoh Club Vol. 1 (Japan) (Track 1).bin / tools / dcv_win / src / cut_sub.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-01  |  9.8 KB  |  359 lines
  1. unit Cut_sub;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, ExtCtrls;
  8.  
  9. var
  10.   dummy: Integer;
  11.   function cutSub(cutFileName:String; cutBmp: TBitMap): Integer;
  12.   function cutType(Ptr:PChar; cutBmp2:TBitMap): Boolean;
  13.   function expand1(org:PChar; count:Integer; cond:PChar): Integer;
  14.   function expand2(org2:PChar; count2:Integer; cond2, lbuff:PChar): Integer;
  15.   function cutType2(Ptr2:PChar; cutBmp3:TBitMap): Boolean;
  16.   function cutPrint(xbuff: PChar; cutWidth, ofset: Integer; cutBmpExe:TBitMap): Boolean;
  17.  
  18. implementation
  19. uses
  20.   Dc_main;
  21.  
  22. function cutSub(cutFileName:String; cutBmp: TBitMap): Integer;
  23. type
  24.     bytePtr = ^Char;
  25. var
  26.    f: file of Byte;
  27.    fileHdl, i, cutOk: Integer;
  28.    cutPt, cutPt2, nstr: PChar;
  29.    buf: Char;
  30.    header, buff, msg: String;
  31.    cutSize: Longint;
  32. begin
  33.      { File Exists? }
  34.      if FileExists(cutFileName) = False then
  35.      begin
  36.           msg := 'カットファイル"' + cutFileName + '"が見つかりません！';
  37.           MessageDlg(msg, mtError, [mbOK], 0);
  38.           cutSub := 0;
  39.           exit;
  40.      end;
  41.      { CutTypeProcced }
  42.      AssignFile(f, cutFileName);
  43.      Reset(f);
  44.      try
  45.         cutSize := FileSize(f);
  46.         GetMem(cutPt, cutSize);
  47.         try
  48.            BlockRead(f, cutPt^, cutSize);
  49.         finally
  50.            { CutFile? }
  51.            cutPt2 := cutPt;
  52.            GetMem(nstr, 64);
  53.            StrPas(StrMove(nstr, cutPt, 48));
  54.            Inc(cutPt,48);
  55.            cutOk := 0;
  56.            if (compareText('CUT_V', Copy(StrPas(nstr),1,5)) = 0) then
  57.            begin
  58.                 cutType(cutPt, cutBmp);
  59.                 cutOk := 1;
  60.            end;
  61.            if (nstr[0] = Chr(0)) then
  62.            begin
  63.                 cutType2(cutPt, cutBmp);
  64.                 cutOk := 1;
  65.            end;
  66.            { Dispose Memory }
  67.            FreeMem(nstr, 64);
  68.            FreeMem(cutPt2, cutSize);
  69.            cutSub := 1;
  70.         end;
  71.         finally;
  72.            CloseFile(f);
  73.         end;
  74. end;
  75.  
  76. function cutType(Ptr:PChar; cutBmp2: TBitMap): Boolean;
  77. var
  78.    xx, yy, xsize, image_y, i: Integer;
  79.    sstr, buffer, bufferPt: PChar;
  80.    head, body: PChar;
  81.    con1, con2, con1buff: PChar;
  82.    dmy, j, y_ofset: integer;
  83.    dmyStr: String;
  84.    dmynull: PChar;
  85.    lineBuf: PChar;
  86.    cutRc: TRect;
  87. begin
  88.      { CutSize? xx,yy }
  89.      GetMem(sstr, 10);
  90.      xx := Integer(Ptr^) * 256;
  91.      Inc(Ptr, 1);
  92.      xx := xx + Integer(Ptr^);
  93.      Inc(Ptr, 1);
  94.      yy := Integer(Ptr^) * 256;
  95.      Inc(Ptr, 1);
  96.      yy := yy + Integer(Ptr^);
  97.      Inc(Ptr, 1);
  98.      FreeMem(sstr, 10);
  99.      { BitMap }
  100.      cutBmp2.canvas.brush.color := clGreen;
  101.      cutBmp2.canvas.FillRect(cutRc);
  102.      cutBmp2.width := xx;
  103.      cutBmp2.height := yy;
  104.      cutBmp2.Monochrome := False;
  105.      { typeCut }
  106.      GetMem(buffer, 256*16);
  107.      GetMem(con1, 256);
  108.      GetMem(con2, 256);
  109.      GetMem(lineBuf, 256);
  110.      xsize := (xx - 1) div 8 + 1;
  111.      image_y := 0;
  112.      y_ofset := -16;
  113.      bufferPt := buffer;
  114.  
  115.      GetMem(dmyNull, 10);
  116.  
  117.      expand2(buffer, 0, con2, lineBuf);
  118.      for i:=1 to yy do
  119.      begin
  120.           con1buff := con1;
  121.           dmy := Integer(Ptr^);
  122.           for j:=1 to dmy do
  123.           begin
  124.               con1buff^ := Ptr^;
  125.               Inc(Ptr, 1);
  126.               Inc(con1buff, 1);
  127.           end;
  128.           dmy := Integer(con1^);
  129.  
  130.           if (dmy<=0) then break;
  131.           expand1(con2, xsize, con1);
  132.           expand2(buffer, xsize, con2, lineBuf);
  133.           Inc(buffer, xsize);
  134.  
  135.           Inc(image_y, 1);
  136.           Inc(y_ofset, 1);
  137.           if (image_y = 16) then
  138.           begin
  139.                image_y := 0;
  140.                buffer := bufferPt;
  141.                cutPrint(buffer, xx, y_ofset, cutBmp2);
  142.           end;
  143.      Application.ProcessMessages;
  144.      end;
  145.      if (image_y > 0) then
  146.      begin
  147.           buffer := bufferPt;
  148.           cutPrint(buffer, xx, y_ofset, cutBmp2);
  149.      end;
  150.      FreeMem(lineBuf, 256);
  151.      FreeMem(con2, 256);
  152.      FreeMem(con1, 256);
  153.      FreeMem(bufferPt, 256*16);
  154.      { Reset FormSize }
  155.      cutRc := Rect(0,0,xx,yy);
  156. end;
  157.  
  158. function expand1(org:PChar; count:Integer; cond:PChar): Integer;
  159. var
  160.    pt, bt, flag, i: Integer;
  161.    head, body: PChar;
  162. begin
  163.      if (cond^ = Chr(1))then
  164.      begin
  165.           for pt:=1 to count do
  166.           begin
  167.               org^ := Chr(0);
  168.               Inc(org, 1);
  169.           end;
  170.           expand1 := count;
  171.           exit;
  172.      end;
  173.      pt := (count - 1) div 8 + 1;
  174.      head := cond + 1;
  175.      body := head + pt;
  176.      for i:= 1 to Pt do
  177.      begin
  178.           flag := Integer(head^);
  179.           Inc(head, 1);
  180.           for bt:=0 to 7 do
  181.           begin
  182.                if ((flag And 128) = 0) then
  183.                   org^ := Chr(0)
  184.                else
  185.                begin
  186.                   org^ := body^;
  187.                   Inc(body, 1);
  188.                end;
  189.                Inc(org, 1);
  190.                flag := flag shl 1;
  191.           end;
  192.      end;
  193.      expand1 := count;
  194. end;
  195.  
  196. function expand2(org2:PChar; count2:Integer; cond2, lbuff:PChar): Integer;
  197. var
  198.      c: Integer;
  199. begin
  200.      if (count2 = 0) then
  201.      begin
  202.         for c := 1 to 128 do
  203.         begin
  204.              lbuff^ := Char(0);
  205.              Inc(lbuff, 1);
  206.         end;
  207.         expand2 := count2;
  208.         exit;
  209.      end;
  210.      for c:=1 to count2 do
  211.      begin
  212.          org2^ := Chr(Integer(cond2^) Xor Integer(lbuff^));
  213.          lbuff^ := org2^;
  214.          Inc(org2, 1);
  215.          Inc(cond2, 1);
  216.          Inc(lbuff, 1);
  217.      end;
  218.      expand2 := count2;
  219. end;
  220.  
  221. function cutType2(Ptr2:PChar; cutBmp3: TBitMap): Boolean;
  222. var
  223.    xx, yy, xsize, image_y, i: Integer;
  224.    sstr, buffer, bufferPt: PChar;
  225.    head, body: PChar;
  226.    dmy, j, y_ofset: integer;
  227.    dmyStr: String;
  228.    dmynull: PChar;
  229.    lineBuf: PChar;
  230.    cutRc: TRect;
  231. begin
  232.      { CutSize? xx,yy }
  233.      GetMem(sstr, 10);
  234.      xx := Integer((Ptr2+16)^) * 256;
  235.      xx := xx + Integer((Ptr2+17)^);
  236.      yy := Integer((Ptr2+18)^) * 256;
  237.      yy := yy + Integer((Ptr2+19)^);
  238.      FreeMem(sstr, 10);
  239.      if (xx<=0) Or (yy<=0) Or (xx>1024) Or (yy>1024) then exit;
  240.      Inc(Ptr2, 20);
  241.      { BitMap }
  242.      cutBmp3.canvas.brush.color := clGreen;
  243.      cutBmp3.canvas.FillRect(cutRc);
  244.      cutBmp3.width := xx;
  245.      cutBmp3.height := yy;
  246.      cutBmp3.Monochrome := False;
  247.      { typeCut }
  248.      if ((xx mod 8) = 0) then
  249.         xsize := (xx div 8) * 16
  250.      else
  251.         xsize := ((xx div 8) + 1) * 16;
  252.      y_ofset := 0;
  253.      for i:=1 to (yy div 16) do
  254.      begin
  255.           cutPrint(Ptr2, xx, y_ofset, cutBmp3);
  256.           Inc(Ptr2, xsize);
  257.           Inc(y_ofset, 16);
  258.           {Application.ProcessMessages;}
  259.      end;
  260.      if ((yy Mod 16) > 0) then
  261.      begin
  262.           cutPrint(Ptr2, xx, y_ofset-16+(yy Mod 16), cutBmp3);
  263.      end;
  264.      { Reset FormSize }
  265.      cutRc := Rect(0,0,xx,yy);
  266. end;
  267.  
  268. function cutPrint(xbuff: PChar; cutWidth, ofset: Integer; cutBmpExe: TBitMap): Boolean;
  269. var
  270.    cr: PChar;
  271.    flg2: Integer;
  272.    i,j,k,ke:Integer;
  273.    x_offset, cll, cll2: Integer;
  274. begin
  275.      if ((ofset mod 16) = 0) then
  276.         ke := 15
  277.      else
  278.      begin
  279.         ke := ofset Mod 16 - 1;
  280.         ofset := ofset + 16 - ke - 1;
  281.      end;
  282.      for k:= 0 to ke do
  283.      begin
  284.          cutBmpExe.canvas.pen.color := clGreen;
  285.          cutBmpExe.canvas.MoveTo(-1,ofset + k);
  286.          for i:=0 to (cutWidth div 8)-1 do
  287.          begin
  288.               flg2 := 128;
  289.               x_offset := i*8;
  290.               for j:=0 to 7 do
  291.               begin
  292.                    if ( Integer(xbuff^) And flg2 <> 0) then
  293.                         cll := 1
  294.                    else
  295.                         cll := 0;
  296.                    if (cll <> cll2) then
  297.                    begin
  298.                         if (cll = 1) then
  299.                         begin
  300.                            cutBmpExe.canvas.pen.color := clGreen;
  301.                            cutBmpExe.canvas.moveTo(x_offset+j,ofset + k);
  302.                         end;
  303.                         if (cll = 0) then
  304.                         begin
  305.                            cutBmpExe.canvas.pen.color := clWhite;
  306.                            cutBmpExe.canvas.LineTo(x_offset+j,ofset + k);
  307.                         end;
  308.                         cll2 := cll;
  309.                    end;
  310.                    flg2 := flg2 shr 1;
  311.               end;
  312.               Inc(xbuff, 1);
  313.          end;
  314.          if ((cutWidth mod 8) > 0) then
  315.          begin
  316.               flg2 := 128;
  317.               x_offset := (i+1)*8;
  318.               for j:=0 to (cutWidth mod 8) do
  319.               begin
  320.                    if ( Integer(xbuff^) And flg2 <> 0) then
  321.                       cll := 1
  322.                    else
  323.                       cll := 0;
  324.                    if (cll <> cll2) then
  325.                    begin
  326.                         if (cll = 1) then
  327.                         begin
  328.                              cutBmpExe.canvas.pen.color := clGreen;
  329.                              cutBmpExe.canvas.moveTo(x_offset+j,ofset + k);
  330.                         end;
  331.                         if (cll = 0) then
  332.                         begin
  333.                              cutBmpExe.canvas.pen.color := clWhite;
  334.                              cutBmpExe.canvas.LineTo(x_offset+j,ofset + k);
  335.                         end;
  336.                         cll2 := cll;
  337.                    end;
  338.                    flg2 := flg2 shr 1;
  339.               end;
  340.               Inc(xbuff, 1);
  341.          end;
  342.          if (cll = 0) then
  343.          begin
  344.               cutBmpExe.canvas.pen.color := clGreen;
  345.               cutBmpExe.canvas.lineTo(cutWidth,ofset + k);
  346.          end;
  347.          if (cll = 1) then
  348.          begin
  349.               cutBmpExe.canvas.pen.color := clWhite;
  350.               cutBmpExe.canvas.LineTo(cutWidth,ofset + k);
  351.          end;
  352.      end;
  353. end;
  354.  
  355.  
  356.  
  357.  
  358. end.
  359.